home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0094_hall of fame - my try.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-25  |  5KB  |  167 lines
  1.  
  2. Unit HighScr;
  3. Interface
  4. Procedure HS_Init(iNum: byte; ifn: string; icode: byte);
  5. {Initializes the highscore manager}
  6. {  iNum: byte -  The number of scores to keep track of.  Setting iNum to 0}
  7. {                makes the program use however many scores it finds in the}
  8. {                list file}
  9. {  ifn: string - The filename of the list file.  If the file exists, it is
  10.                  opened; otherwise, a new file is created.  If iNum if set to
  11.                  more names than are in ifn, extra spaces are left blank.  If
  12.                  ifn has too many, the extras are ignored.
  13.                  NOTE:  do not make inum=0 if you are creating a new list
  14.                  file}
  15. {  icode: byte - encoding number, where 0=no encoding.  The higher the
  16.                  number, the less recognizable the output file}
  17.  
  18. Function HS_CheckScore(score: longint): boolean;
  19. {Checks to see if a score would make the highscore list}
  20. {  score: longint - the score to check}
  21. {Returns TRUE if the score made the list}
  22.  
  23. Function HS_NewScore(name: string; score: longint): boolean;
  24. {Adds a new score to the list if it belongs}
  25. {  name: string -   the name of the player}
  26. {  score: longint - the player's score}
  27. {Returns TRUE if the score made the list}
  28.  
  29. Procedure HS_Clear;
  30. {Clears the highscore list, setting all names to dashes, all scores to 0}
  31.  
  32. Function HS_Name(i: byte): string;
  33. {Returns the name from the Ith place of the list}
  34. {  i: byte - the rank to check}
  35.  
  36. Function HS_Score(i: byte): longint;
  37. {Returns the score from the Ith place of the list}
  38. {  i: byte - the rank to check}
  39.  
  40. Procedure HS_Done;
  41. {Disposes of the highscore manager and saves the highscore list}
  42.  
  43. Implementation
  44. Uses
  45.   Dos;
  46. Type
  47.   PHSItem = ^THSItem;
  48.   THSItem = record
  49.               name:                     string[25];
  50.               score:                    longint;
  51.             end;
  52.   PHSItemList = ^THSItemList;
  53.   THSItemList = array[1..100] of THSItem;
  54. Var
  55.   numitems, code:                       byte;
  56.   item:                                 PHSItemList;
  57.   fn:                                   string[50];
  58. Procedure FlipBit(var Buf; len, code: byte);
  59. Type
  60.   TBuf = array[0..255] of byte;
  61. var
  62.   i:                                    byte;
  63. begin
  64.   for i:=0 to len-1 do
  65.     TBuf(Buf)[i]:=TBuf(Buf)[i] XOR Code;
  66. end;
  67. Function GetStr(var f: file): string;
  68. var
  69.   s:                                    string;
  70. begin
  71.   BlockRead(f, s[0], 1);
  72.   BlockRead(f, s[1], ord(s[0]));
  73.   GetStr:=s;
  74. end;
  75. Function Exist(fn: string): boolean;
  76. Var
  77.   SRec:                                 SearchRec;
  78. Begin
  79.   FindFirst(fn, $3F, SRec);
  80.   If DosError>0 then Exist:=False else Exist:=True;
  81. End;
  82. Procedure HS_Init(iNum: byte; ifn: string; icode: byte);
  83. var
  84.   f:                                    file;
  85.   i, found:                             byte;
  86. begin
  87.   fn:=ifn;
  88.   code:=icode;
  89.   numitems:=iNum;
  90.   GetMem(item, 30*numitems);
  91.   HS_Clear;
  92.   if exist(fn) then
  93.   begin
  94.     Assign(f, fn);
  95.     Reset(f, 1);
  96.     BlockRead(f, found, 1);
  97.     if numitems=0 then numitems:=found;
  98.     if found>numitems then found:=numitems;
  99.     for i:=1 to found do
  100.     begin
  101.       item^[i].name:=GetStr(f);
  102.       FlipBit(item^[i].name[1], ord(item^[i].name[0]), code);
  103.       BlockRead(f, item^[i].score, 4);
  104.       FlipBit(item^[i].score, 4, code);
  105.     end;
  106.   end;
  107.   if numitems=0 then numitems:=1;
  108. end;
  109. Function HS_CheckScore(score: longint): boolean;
  110. begin
  111.   if score>item^[numitems].score then HS_CheckScore:=TRUE else HS_CheckScore:=FALSE;
  112. end;
  113. Function HS_NewScore(name: string; score: longint): boolean;
  114. var
  115.   i, j:                                 byte;
  116.   on:                                   boolean;
  117. begin
  118.   HS_NewScore:=FALSE;
  119.   for i:=1 to numitems do
  120.     if score>item^[i].score then
  121.     begin
  122.       for j:=numitems downto i+1 do
  123.         item^[j]:=item^[j-1];
  124.       item^[i].name:=name;
  125.       item^[i].score:=score;
  126.       score:=0;
  127.       i:=numitems;
  128.       HS_NewScore:=TRUE;
  129.     end;
  130. end;
  131. Procedure HS_Clear;
  132. var
  133.   i:                                    byte;
  134. begin
  135.   for i:=1 to numitems do
  136.   begin
  137.     item^[i].name:='-------------------------';
  138.     item^[i].score:=0;
  139.   end;
  140. end;
  141. Function HS_Name(i: byte): string;
  142. begin
  143.   HS_Name:=item^[i].name;
  144. end;
  145. Function HS_Score(i: byte): longint;
  146. begin
  147.   HS_Score:=item^[i].score;
  148. end;
  149. Procedure HS_Done;
  150. var
  151.   f:                                    file;
  152.   i:                                    byte;
  153. begin
  154.   Assign(f, fn);
  155.   Rewrite(f, 1);
  156.   BlockWrite(f, numitems, 1);
  157.   for i:=1 to numitems do
  158.   begin
  159.     FlipBit(item^[i].name[1], ord(item^[i].name[0]), code);
  160.     BlockWrite(f, item^[i].name, ord(item^[i].name[0])+1);
  161.     FlipBit(item^[i].score, 4, code);
  162.     BlockWrite(f, item^[i].score, 4);
  163.   end;
  164.   FreeMem(item, 30*numitems);
  165. end;
  166. End.
  167.